home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TSR
/
PPTSR10
/
FILER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-12
|
4KB
|
181 lines
(*
Program : filer.pas
Function : Example TSR program to view a file. Very basic viewing !!
Author : P.Peters
Date : June 1992
*)
{$m $1000,0,0}
{$r-,s-,x+}
program filer;
uses
crt,tsrutil,tsr;
const
idcode = $c3;
filename : string = '';
var
fil : text;
scr : array[1..4000] of byte;
sat : byte;
function fileexists( filename : string ) : boolean;
var
f: file;
begin
{$i-} assign( f,filename ); reset( f ); close( f ); {$i+}
fileexists := (ioresult = 0) and (filename <> '');
end;
function waitkey : word;
begin
write('Press any key to continue...');
repeat until keyavail;
waitkey := readkeycode;
write(^m);
clreol;
end;
procedure filit; far;
var s : string;
i : word;
k : word;
begin
assign(fil,filename);
{$i-}reset(fil);{$i+}
if ioresult = 0 then begin
i := 0;
cursoroff;
savescreen(1,1,80,25,scr);
sat := textattr;
textbackground(white);
textcolor(black);
clrscr;
k := 0;
while (lo(k) <> 27) and (not eof(fil)) do begin
readln(fil,s);
writeln(s);
inc(i);
if (i mod 24) = 0 then k := waitkey;
end;
if (i mod 24) <> 0 then waitkey;
textattr := sat;
restorescreen(1,1,80,25,scr);
cursoron;
end;
{$i-}close(fil);{$i+}
end;
procedure receiver; far; assembler;
label
tst3,fin;
asm
cmp ax,2 {set file name}
jne tst3
mov ds,bx
mov si,cx
mov ch,0
mov cl,ds:[si]
inc cx
mov bx,seg filename
mov es,bx
mov di,offset filename
repnz movsb
jmp fin
tst3:
cmp ax,3 {get name}
jne fin
mov bx,seg filename
mov cx,offset filename
fin:
end;
procedure paramcheck; far;
var
s : string;
i : byte;
procedure setfilename;
begin
filename := s;
if tsrloaded then begin
asm
pusha
mov bx,seg filename
mov cx,offset filename
mov ax,idcode shl 8 + 2
int 2fh
popa
end;
end;
end;
procedure getinfo;
begin
if tsrloaded then begin
asm
pusha
mov ax,idcode shl 8 + 3
int 2fh
mov ds,bx
mov si,cx
mov ch,0
mov cl,ds:[si]
inc cx
mov bx,seg filename
mov es,bx
mov di,offset filename
repnz movsb
popa
end;
writeln('Info from Tsr');
writeln(' Filename : ',filename);
end else begin
writeln('Tsr receiver not installed.');
halt;
end;
end;
procedure writeopt;
begin
writeln('Usage:');
writeln(' Filer [Option]');
writeln('Options:');
writeln(' /u : Remove Tsr');
writeln(' /i : Display this info from Tsr');
writeln(' <name> : file to display');
halt;
end;
begin
if paramcount > 0 then
for i := 1 to paramcount do begin
s := paramstr(i);
if s[1] = '/' then begin (* switch *)
delete(s,1,1);
s[1] := upcase(s[1]);
case s[1] of
'I' : getinfo;
'?' : writeopt;
else begin
writeln('Invalid switch : ',s);
writeopt;
end;
end;
end else begin (* no switch *)
if fileexists( s ) then
setfilename
else begin
Writeln(^g'File not found : ',s );
halt;
end;
end;
end;
end;
begin
if paramcount = 0 then
writeln(^g'Parameter or switch required.')
else
tsrinstall('Alt-F',$2100,idcode,filit,receiver,paramcheck);
end.